home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 42 / Amiga Format AFCD42 (Issue 126, Aug 1999).iso / -serious- / programming / other / wild / support / metastuff_a.bas < prev    next >
BASIC Source File  |  1999-05-25  |  8KB  |  310 lines
  1. SCREEN 1,720,455,2,5
  2. WINDOW 1,"METAStuffing ...",(0,0)-(640,400),,1
  3.  
  4. '$INCLUDE BASU:_METAConsts.bas
  5. '$INCLUDE BASU:_CutWord.bas
  6. '$INCLUDE BASU:_LoadMETA.bas
  7. '$INCLUDE BASU:_Prox.bas
  8. '$INCLUDE BASU:_SafeLine.bas
  9. '$INCLUDE BASU:_METAViewTD.bas
  10. '$INCLUDE BASU:_WAITKEY.bas
  11.  
  12. CONST STUCX%=1
  13. CONST STUCY%=2
  14. CONST STUCZ%=3
  15. CONST STUR%=4
  16. CONST STUFACS%=10
  17. CONST STUMAX%=30
  18.  
  19. METAIN$="EscapeLevels:META/Tree.META"
  20. LoadMETA(METAIN$)
  21. WILDOUT$="Ram:Stuff.s"
  22. FOR i=1 TO 12
  23.  READ ObjRef(i)
  24. NEXT i
  25. viewmode&=VIEWMODE_WIRE&+VIEWFLAG_SELSHOW&
  26. CurFace=1
  27.  
  28. ST=100
  29. REPEAT cyc
  30. a$=UCASE$(WAITKEY$)
  31. SELECT CASE a$
  32.  CASE "X"
  33.   EXIT cyc
  34.  CASE "["
  35.   ObjRef(REF_O%+REF_X%)=ObjRef(REF_O%+REF_X%)-ST
  36.  CASE "]"
  37.   ObjRef(REF_O%+REF_X%)=ObjRef(REF_O%+REF_X%)+ST
  38.  CASE "-"
  39.   ObjRef(REF_O%+REF_Y%)=ObjRef(REF_O%+REF_Y%)-ST
  40.  CASE "+"
  41.   ObjRef(REF_O%+REF_Y%)=ObjRef(REF_O%+REF_Y%)+ST
  42.  CASE "*"
  43.   ObjRef(REF_O%+REF_Z%)=ObjRef(REF_O%+REF_Z%)+ST
  44.  CASE "9"
  45.   ObjRef(REF_O%+REF_Z%)=ObjRef(REF_O%+REF_Z%)-ST
  46.  CASE "2"
  47.   CALL RotRef(STA,REF_J%,REF_K%)
  48.  CASE "8"
  49.   CALL RotRef(-STA,REF_J%,REF_K%)
  50.  CASE "6"
  51.   CALL RotRef(STA,REF_I%,REF_K%)
  52.  CASE "4"
  53.   CALL RotRef(-STA,REF_I%,REF_K%)
  54.  CASE "5"
  55.   CALL RotRef(STA,REF_I%,REF_J%)
  56. END SELECT
  57. GOSUB Refresh
  58. END REPEAT cyc
  59. GOSUB stuffing
  60. END
  61. Refresh:
  62. CALL METAViewTD
  63. CLS
  64. CALL METARedrawTD(1,1,WINDOW(2),WINDOW(3),viewmode&)
  65. RETURN
  66.  
  67.  
  68. DATA 0,0,1000
  69. DATA 1,0,0
  70. DATA 0,1,0
  71. DATA 0,0,1
  72.  
  73. Stuffing:
  74. DIM Stuff(500,STUMAX%),Usf(10)
  75.  
  76. MAXD&=0:BESTA=0:BESTB=0
  77. FOR i=1 TO NDOT-1
  78.  FOR j=i+1 TO NDOT
  79.   D&=(Dot(i,DOTX%)-Dot(j,DOTX%))^2+(Dot(i,DOTY%)-Dot(j,DOTY%))^2+(Dot(i,DOTZ%)-Dot(j,DOTZ%))^2
  80.   IF D&>MAXD& THEN MAXD&=D&:BESTA=i:BESTB=j
  81.  NEXT j
  82. NEXT i
  83.  
  84. BigSCX=(Dot(BESTA,DOTX%)+Dot(BESTB,DOTX%))/2
  85. BigSCY=(Dot(BESTA,DOTY%)+Dot(BESTB,DOTY%))/2
  86. BigSCZ=(Dot(BESTA,DOTZ%)+Dot(BESTB,DOTZ%))/2
  87. BigSR=MAXD&^.5
  88.  
  89. SUB DrawX(x,y,r,c)
  90.  LINE (x-r,y-r)-(x+r,y+r),c
  91.  LINE (x-r,y+r)-(x+r,y-r),c
  92. END SUB
  93.  
  94. FUNCTION METADistancePointFace(f,x,y,z)
  95.  SHARED Face(),Dot(),hx,hy
  96.  Cx=Dot(Face(f,FACPC%),DOTX%)
  97.  Cy=Dot(Face(f,FACPC%),DOTY%)
  98.  Cz=Dot(Face(f,FACPC%),DOTZ%)
  99.  YOSC=Dot(Face(f,FACPC%),DOTYOS%)
  100.  XOSC=Dot(Face(f,FACPC%),DOTXOS%)
  101.  CALL DrawX(XOSC+hx,YOSC+hy,5,3)
  102.  Ax=Dot(Face(f,FACPA%),DOTX%)-Cx
  103.  Ay=Dot(Face(f,FACPA%),DOTY%)-Cy
  104.  Az=Dot(Face(f,FACPA%),DOTZ%)-Cz
  105.  Bx=Dot(Face(f,FACPB%),DOTX%)-Cx
  106.  By=Dot(Face(f,FACPB%),DOTY%)-Cy
  107.  Bz=Dot(Face(f,FACPB%),DOTZ%)-Cz
  108.  xr=x-Cx
  109.  yr=y-Cy
  110.  zr=z-Cz
  111.  Ik=Bz*Ay-Az*By
  112.  Jk=Az*Bx-Bz*Ax
  113.  Kk=By*Ax-Bx*Ay
  114.  Lk=(Ik^2+Jk^2+Kk^2)^.5
  115.  PS=Ik*xr+Jk*yr+Kk*zr
  116.  d=PS/Lk
  117.  METADistancePointFace=d
  118. END FUNCTION
  119.  
  120. SUB SphereDraw(x,y,z,r)
  121.  xos=ProX(x,z)
  122.  yos=ProY(y,z)
  123.  ros=ABS((ABS(r)*256)/(z+256))
  124.  PRINT "ros ",ros
  125.  CIRCLE (xos,yos),ros,3,,,1
  126. END SUB
  127.  
  128. ' Condizioni per ogni sfera:
  129. ' essere tangente a tre facce almeno, che determinano quasi tutto.
  130. ' poi, trovate le coordinate del centro in funzione del raggio, provare con tutte
  131. ' le altre facce il raggio massimo.
  132. ' Trovo centro (px,py,pz) in funzione del raggio:
  133. ' sistema 4x3:
  134. ' ax*px+ay*py+az*pz=r*|a| (a è la normale della face!)
  135. ' idem per b e c.
  136. ' L'equazione deriva dalla formula per la distanza face-point: d=ProdScal/|normale|
  137. ' guarda anche la procedura METADistanceFacePoint
  138. ' Risolvo il sistema, lasciando r come parametro.
  139. ' Matrice:     | ax ay az |    | r*|a| |
  140. '        | bx by bz |    | r*|b| |
  141. '        | cx cy cz |    | r*|c| |
  142. ' MA ! ERRORE !
  143. ' px,py,pz erano relativi al punto c di ogni face!
  144. ' cx,cy,cz sono gli assoluti: cx=px-xc(face)
  145. ' L'equazione diventa:
  146. ' ax*cx+ay*cy+az*cz=r*|a|+xc*ax+yc*ay+zc*az
  147.  
  148. COLOR 1,0
  149. NSTU=0
  150. MINR=20
  151. FOR i=1 TO NDOT
  152.  NUSF=0
  153.  FOR j=1 TO NFAC
  154.   IF Face(j,FACPA%)=i OR Face(j,FACPB%)=i OR Face(j,FACPC%)=i THEN NUSF=NUSF+1:Usf(NUSF)=j
  155.  NEXT j
  156.  IF NUSF>=3
  157.   fa=Usf(1)
  158.   fb=Usf(2)
  159.   fc=Usf(3)
  160.  
  161.   PRINT "Faces: ",fa;fb;fc
  162.   
  163.   axc=Dot(Face(fa,FACPC%),DOTX%)
  164.   ayc=Dot(Face(fa,FACPC%),DOTY%)
  165.   azc=Dot(Face(fa,FACPC%),DOTZ%)
  166.   axa=Dot(Face(fa,FACPA%),DOTX%)-axc
  167.   aya=Dot(Face(fa,FACPA%),DOTY%)-ayc
  168.   aza=Dot(Face(fa,FACPA%),DOTZ%)-azc
  169.   axb=Dot(Face(fa,FACPB%),DOTX%)-axc
  170.   ayb=Dot(Face(fa,FACPB%),DOTY%)-ayc
  171.   azb=Dot(Face(fa,FACPB%),DOTZ%)-azc
  172.   kax=azb*aya-aza*ayb
  173.   kay=aza*axb-azb*axa
  174.   kaz=axa*ayb-aya*axb
  175.   lka=(kax^2+kay^2+kaz^2)^.5
  176.   PRINT "lka ",lka
  177.   bxc=Dot(Face(fb,FACPC%),DOTX%)
  178.   byc=Dot(Face(fb,FACPC%),DOTY%)
  179.   bzc=Dot(Face(fb,FACPC%),DOTZ%)
  180.   bxa=Dot(Face(fb,FACPA%),DOTX%)-bxc
  181.   bya=Dot(Face(fb,FACPA%),DOTY%)-byc
  182.   bza=Dot(Face(fb,FACPA%),DOTZ%)-bzc
  183.   bxb=Dot(Face(fb,FACPB%),DOTX%)-bxc
  184.   byb=Dot(Face(fb,FACPB%),DOTY%)-byc
  185.   bzb=Dot(Face(fb,FACPB%),DOTZ%)-bzc
  186.   kbx=bzb*bya-bza*byb
  187.   kby=bza*bxb-bzb*bxa
  188.   kbz=bxa*byb-bya*bxb
  189.   lkb=(kbx^2+kby^2+kbz^2)^.5
  190.   PRINT "lkb ",lkb
  191.   cxc=Dot(Face(fc,FACPC%),DOTX%)
  192.   cycy=Dot(Face(fc,FACPC%),DOTY%)
  193.   czc=Dot(Face(fc,FACPC%),DOTZ%)
  194.   cxa=Dot(Face(fc,FACPA%),DOTX%)-cxc
  195.   cya=Dot(Face(fc,FACPA%),DOTY%)-cycy
  196.   cza=Dot(Face(fc,FACPA%),DOTZ%)-czc
  197.   cxb=Dot(Face(fc,FACPB%),DOTX%)-cxc
  198.   cyb=Dot(Face(fc,FACPB%),DOTY%)-cycy
  199.   czb=Dot(Face(fc,FACPB%),DOTZ%)-czcy
  200.   kcx=czb*cya-cza*cyb
  201.   kcy=cza*cxb-czb*cxa
  202.   kcz=cxa*cyb-cya*cxb
  203.   lkc=(kcx^2+kcy^2+kcz^2)^.5
  204.   PRINT "lkc ",lkc
  205.  
  206. ' la matrice:
  207. ' | ax ay az | | ma |
  208. ' | bx by bz | | mb |
  209. ' | cx cy cz | | mc |
  210.  
  211.   ma=axc*kax+ayc*kay+azc*kaz
  212.   mb=bxc*kbx+byc*kby+bzc*kbz
  213.   mc=cxc*kcx+cycy*kcy+czc*kcz
  214.   PRINT "ma,mb,mc ",ma,mb,mc
  215.   det=kax*kby*kcz+kay*kbz*kcx+kaz*kbx*kcy-kaz*kby*kcx-kay*kbx*kcz-kax*kbz*kcy
  216.   PRINT "det ",det
  217.  
  218. ' ora:
  219. ' cx=det    | r|a|+ma ay az|
  220. '        | r|b|+mb by bz|
  221. '        | r|c|+mc cy cz|
  222.  
  223.   mako=kby*kcz-kbz*kcy
  224.   mbko=kcy*kaz-kay*kcz
  225.   mcko=kay*kbz-kaz*kby
  226.   PRINT "mxko a,b,c ",mako,mbko,mcko
  227.   cxtn=mako*ma+mbko*mb+mcko*mc    ' termine noto nell'equazione: cx=(cxtn+r*rcxko)/det
  228.   rcxko=lka*mako+lkb*mbko+lkc*mcko    ' coefficiente del raggio nell'eq sopra.
  229.  
  230.   mako=kbx*kcz-kbz*kcx
  231.   mbko=kcy*kaz-kax*kcz
  232.   mcko=kax*kbz-kaz*kbx
  233.   PRINT "myko a,b,c ",mako,mbko,mcko
  234.   cytn=mako*ma+mbko*mb+mcko*mc    ' termine noto nell'equazione: cy=(cytn+r*rcyko)/det
  235.   rcyko=lka*mako+lkb*mbko+lkc*mcko    ' coefficiente del raggio nell'eq sopra.
  236.  
  237.   mako=kby*kcx-kbx*kcy
  238.   mbko=kcy*kax-kay*kcx
  239.   mcko=kay*kbx-kax*kby
  240.   PRINT "mzko a,b,c ",mako,mbko,mcko
  241.   cztn=mako*ma+mbko*mb+mcko*mc    ' termine noto nell'equazione: cz=(cztn+r*rczko)/det
  242.   rczko=lka*mako+lkb*mbko+lkc*mcko    ' coefficiente del raggio nell'eq sopra.
  243.  
  244.   PRINT "ctn x,y,z ",cxtn,cytn,cztn
  245.   PRINT "rko x,y,z ",rcxko,rcyko,rczko
  246. ' ora:
  247. ' cx=(cxtn+r*rcxko)/det
  248. ' cy=(cytn+r*rcyko)/det  
  249. ' cz=(cztn+r*rczko)/det  
  250. ' kfx*cx+kfy*cy+kfz*cz>r*|kf|    per testare le altre facce e trovare il >r possibile.
  251. ' quindi:
  252. ' kfx*cxtn/det+kfy*cytn/det+kfz*cztn/det>r*(|kf|-rcxko/det-rcyko/det-rczko/det)
  253. ' MA! NO!
  254. ' cx assoluti, ma devo relativizzarli! (come ho fatto prima con i ma,mb,mc)
  255. ' la disequazione di prima (2 sopra) diventa:
  256. ' kfx*(cx-fxc)+kfy*(cy-fyc)+kfz*(cz-fzc)>r*|kf|
  257. ' quindi:
  258. ' kfx*(cxtn/det+r*rcxko/det-fxc) ...
  259.   kfxko=cxtn/det
  260.   kfyko=cytn/det
  261.   kfzko=cztn/det
  262.   rkotn=-(rcxko+rcyko+rczko)/det
  263.   PRINT "kfko x,y,z,r",kfxko,kfyko,kfzko,rkotn
  264. ' kfx*(kfxko-fxc)+...>r*(|kf|+rkotn)
  265. ' ftn>r*frko
  266.  
  267.   rmin=BigSR
  268. '  FOR j=1 TO NFAC
  269. '   IF j<>fa AND j<>fb AND j<>fc
  270. '    fxc=Dot(Face(j,FACPC%),DOTX%)
  271. '    fyc=Dot(Face(j,FACPC%),DOTY%)
  272. '    fzc=Dot(Face(j,FACPC%),DOTZ%)
  273. '    fxa=Dot(Face(j,FACPA%),DOTX%)-fxc
  274. '    fya=Dot(Face(j,FACPA%),DOTY%)-fyc
  275. '    fza=Dot(Face(j,FACPA%),DOTZ%)-fzc
  276. '    fxb=Dot(Face(j,FACPB%),DOTX%)-fxc
  277. '    fyb=Dot(Face(j,FACPB%),DOTY%)-fyc
  278. '    fzb=Dot(Face(j,FACPB%),DOTZ%)-fzc
  279. '    kfx=fzb*fya-fza*cyb
  280. '    kfy=fza*fxb-fzb*cxa
  281. '    kfz=fxa*fyb-fya*cxb
  282. '    lkf=(kfx^2+kfy^2+kfz^2)^.5
  283. '    frko=(lkf+rkotn)
  284. '''    IF frko<=0 THEN PRINT "ERROR!",frko,lkf,rkotn
  285. '    ftn=kfx*(kfxko-fxc)+kfy*(kfyko-fyc)+kfz*(kfzko-fzc)
  286. '    rminf=ftn/frko
  287. '    cxf=(cxtn+rminf*rcxko)/det
  288. '    cyf=(cytn+rminf*rcyko)/det
  289. '    czf=(cztn+rminf*rczko)/det
  290. '    PRINT "frko,ftn",frko,ftn
  291. '    PRINT rmin,cxf,cyf,czf,cxtn,cytn,cztn
  292. '   END IF  
  293. '   IF rminf<rmin THEN rmin=rminf
  294. '  NEXT j
  295.  END IF 
  296.  r=20
  297.  cxf=(cxtn+r*rcxko)/det
  298.  cyf=(cytn+r*rcyko)/det
  299.  czf=(cztn+r*rczko)/det
  300.  GOSUB Refresh
  301.  CALL SphereDraw(cxf,cyf,czf,r)
  302.  
  303. NEXT i
  304.  
  305.  
  306.  
  307.  
  308.   
  309.  
  310.